home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / terr.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-11-22  |  7.7 KB  |  240 lines
  1. /* terr.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  26.         sfactr;
  27.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  28.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  29. } status_;
  30.  
  31. #define status_1 status_
  32.  
  33. struct {
  34.     doublereal twopi, xlog2, xlog10, root2, rad, boltz, charge, ctok, gmin, 
  35.         reltol, abstol, vntol, trtol, chgtol, eps0, epssil, epsox, pivtol,
  36.          pivrel;
  37. } knstnt_;
  38.  
  39. #define knstnt_1 knstnt_
  40.  
  41. struct {
  42.     doublereal value[200000];
  43. } blank_;
  44.  
  45. #define blank_1 blank_
  46.  
  47. /*<       subroutine terr(loct,delnew) >*/
  48. /* Subroutine */ int terr_(loct, delnew)
  49. integer *loct;
  50. doublereal *delnew;
  51. {
  52.     /* Initialized data */
  53.  
  54.     static doublereal coef[6] = { .5,.2222222222,.1363636364,.096,
  55.         .07299270073,.0583090379 };
  56.     static doublereal xtwelv = .08333333333;
  57.  
  58.     /* System generated locals */
  59.     integer i_1;
  60.     doublereal d_1, d_2, d_3, d_4;
  61.  
  62.     /* Builtin functions */
  63.     double sqrt(), log(), exp();
  64.  
  65.     /* Local variables */
  66. #define ccap ((doublereal *)&blank_1 + 1)
  67.     static doublereal diff[8];
  68. #define qcap ((doublereal *)&blank_1)
  69.     static doublereal ctol;
  70.     static integer i;
  71.     static doublereal const_;
  72.     static integer istop;
  73. #define nodplc ((integer *)&blank_1)
  74. #define cvalue ((complex *)&blank_1)
  75.     static doublereal deltmp[7], del, tol;
  76.  
  77. /*<       implicit double precision (a-h,o-z) >*/
  78.  
  79. /*     this routine estimates the local truncation error for a particular 
  80. */
  81. /* circuit element.  it then computes the appropriate stepsize which */
  82. /* should be used. */
  83.  
  84. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  85. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  86. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  87. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  88. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  89. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  90. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  91. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  92. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  93. /* spice version 2g.6  sccsid=status 3/15/83 */
  94. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  95. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  96. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  97. /* spice version 2g.6  sccsid=knstnt 3/15/83 */
  98. /*<       common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok, >*/
  99. /*<      1   gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox, >*/
  100. /*<      2   pivtol,pivrel >*/
  101. /* spice version 2g.6  sccsid=blank 3/15/83 */
  102. /*<       common /blank/ value(200000) >*/
  103. /*<       integer nodplc(64) >*/
  104. /*<       complex cvalue(32) >*/
  105. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  106.  
  107.  
  108. /*<       dimension qcap(1),ccap(1),diff(8),deltmp(7),coef(6) >*/
  109. /*<       equivalence (qcap(1),value(1)),(ccap(1),value(2)) >*/
  110. /*<       data coef / 5.000000000d-1, 2.222222222d-1, 1.363636364d-1, >*/
  111. /*<      1            9.600000000d-2, 7.299270073d-2, 5.830903790d-2 / >*/
  112. /*<       data xtwelv / 8.333333333d-2 / >*/
  113.  
  114.  
  115. /*<       tol=reltol*dmax1(dabs(ccap(lx0+loct)),dabs(ccap(lx1+loct)))+abstol >*/
  116. /* Computing MAX */
  117.     d_3 = (d_1 = ccap[tabinf_1.lx0 + *loct - 1], abs(d_1)), d_4 = (d_2 = ccap[
  118.         tabinf_1.lx1 + *loct - 1], abs(d_2));
  119.     tol = knstnt_1.reltol * max(d_4,d_3) + knstnt_1.abstol;
  120. /*<       ctol=reltol*dmax1(dabs(qcap(lx0+loct)),dabs(qcap(lx1+loct)), >*/
  121. /*<      1   chgtol)/delta >*/
  122. /* Computing MAX */
  123.     d_3 = (d_1 = qcap[tabinf_1.lx0 + *loct - 1], abs(d_1)), d_4 = (d_2 = qcap[
  124.         tabinf_1.lx1 + *loct - 1], abs(d_2)), d_3 = max(d_4,d_3);
  125.     ctol = knstnt_1.reltol * max(knstnt_1.chgtol,d_3) / status_1.delta;
  126. /*<       tol=dmax1(tol,ctol) >*/
  127.     tol = max(tol,ctol);
  128.  
  129. /*  determine divided differences */
  130.  
  131. /*<       go to (6,5,4,3,2,1), iord >*/
  132.     switch (status_1.iord) {
  133.     case 1:  goto L6;
  134.     case 2:  goto L5;
  135.     case 3:  goto L4;
  136.     case 4:  goto L3;
  137.     case 5:  goto L2;
  138.     case 6:  goto L1;
  139.     }
  140. /*<     1 diff(8)=qcap(lx7+loct) >*/
  141. L1:
  142.     diff[7] = qcap[tabinf_1.lx7 + *loct - 1];
  143. /*<     2 diff(7)=qcap(lx6+loct) >*/
  144. L2:
  145.     diff[6] = qcap[tabinf_1.lx6 + *loct - 1];
  146. /*<     3 diff(6)=qcap(lx5+loct) >*/
  147. L3:
  148.     diff[5] = qcap[tabinf_1.lx5 + *loct - 1];
  149. /*<     4 diff(5)=qcap(lx4+loct) >*/
  150. L4:
  151.     diff[4] = qcap[tabinf_1.lx4 + *loct - 1];
  152. /*<     5 diff(4)=qcap(lx3+loct) >*/
  153. L5:
  154.     diff[3] = qcap[tabinf_1.lx3 + *loct - 1];
  155. /*<     6 diff(3)=qcap(lx2+loct) >*/
  156. L6:
  157.     diff[2] = qcap[tabinf_1.lx2 + *loct - 1];
  158. /*<       diff(2)=qcap(lx1+loct) >*/
  159.     diff[1] = qcap[tabinf_1.lx1 + *loct - 1];
  160. /*<       diff(1)=qcap(lx0+loct) >*/
  161.     diff[0] = qcap[tabinf_1.lx0 + *loct - 1];
  162. /*<       istop=iord+1 >*/
  163.     istop = status_1.iord + 1;
  164. /*<       do 10 i=1,istop >*/
  165.     i_1 = istop;
  166.     for (i = 1; i <= i_1; ++i) {
  167. /*<       deltmp(i)=delold(i) >*/
  168.     deltmp[i - 1] = status_1.delold[i - 1];
  169. /*<    10 continue >*/
  170. /* L10: */
  171.     }
  172. /*<    20 do 30 i=1,istop >*/
  173. L20:
  174.     i_1 = istop;
  175.     for (i = 1; i <= i_1; ++i) {
  176. /*<       diff(i)=(diff(i)-diff(i+1))/deltmp(i) >*/
  177.     diff[i - 1] = (diff[i - 1] - diff[i]) / deltmp[i - 1];
  178. /*<    30 continue >*/
  179. /* L30: */
  180.     }
  181. /*<       istop=istop-1 >*/
  182.     --istop;
  183. /*<       if (istop.eq.0) go to 100 >*/
  184.     if (istop == 0) {
  185.     goto L100;
  186.     }
  187. /*<       do 40 i=1,istop >*/
  188.     i_1 = istop;
  189.     for (i = 1; i <= i_1; ++i) {
  190. /*<       deltmp(i)=deltmp(i+1)+delold(i) >*/
  191.     deltmp[i - 1] = deltmp[i] + status_1.delold[i - 1];
  192. /*<    40 continue >*/
  193. /* L40: */
  194.     }
  195. /*<       go to 20 >*/
  196.     goto L20;
  197.  
  198. /*  diff(1) contains divided difference */
  199.  
  200. /*<   100 const=coef(iord) >*/
  201. L100:
  202.     const_ = coef[status_1.iord - 1];
  203. /*<       if ((method.eq.1).and.(iord.eq.2)) const=xtwelv >*/
  204.     if (status_1.method == 1 && status_1.iord == 2) {
  205.     const_ = xtwelv;
  206.     }
  207. /*<       del=trtol*tol/dmax1(abstol,const*dabs(diff(1))) >*/
  208. /* Computing MAX */
  209.     d_1 = knstnt_1.abstol, d_2 = const_ * abs(diff[0]);
  210.     del = knstnt_1.trtol * tol / max(d_2,d_1);
  211. /*<       if (iord.eq.1) go to 200 >*/
  212.     if (status_1.iord == 1) {
  213.     goto L200;
  214.     }
  215. /*<       if (iord.ge.3) go to 150 >*/
  216.     if (status_1.iord >= 3) {
  217.     goto L150;
  218.     }
  219. /*<       del=dsqrt(del) >*/
  220.     del = sqrt(del);
  221. /*<       go to 200 >*/
  222.     goto L200;
  223. /*<   150 del=dexp(dlog(del)/dble(iord)) >*/
  224. L150:
  225.     del = exp(log(del) / (doublereal) status_1.iord);
  226. /*<   200 delnew=dmin1(delnew,del) >*/
  227. L200:
  228.     *delnew = min(*delnew,del);
  229. /*<       return >*/
  230.     return 0;
  231. /*<       end >*/
  232. } /* terr_ */
  233.  
  234. #undef cvalue
  235. #undef nodplc
  236. #undef qcap
  237. #undef ccap
  238.  
  239.  
  240.